home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 January / Macworld (1998-01).dmg / Shareware World / Comms & Internet / HTML mode 2.0 etc. / hctsmslMenu.tcl < prev    next >
Text File  |  1997-09-22  |  14KB  |  390 lines
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  HTML and CSS mode - tools for editing Cascading Style Sheets
  4.  # 
  5.  #  FILE: "hctsmslMenu.tcl"
  6.  #                                    created: 97-03-01 17.33.59 
  7.  #                                last update: 97-09-20 19.43.34 
  8.  #  Author: Johan Linde
  9.  #  E-mail: <jl@theophys.kth.se>
  10.  #     www: <http://bach.theophys.kth.se/~jl/Alpha.html>
  11.  #  
  12.  # Version: 2.0 and 1.0
  13.  # 
  14.  # Copyright 1996, 1997 by Johan Linde
  15.  #  
  16.  # This software may be used freely, and distributed freely, as long as the 
  17.  # receiver is not obligated in any way by receiving it.
  18.  #  
  19.  # If you make improvements to this file, please share them!
  20.  # 
  21.  # ###################################################################
  22.  ##
  23.  
  24. proc hctsmslMenu.tcl {} {}
  25.  
  26. # Variables defining submenus.
  27. set htmlStyleSub {{"" Style STYLE} {"" Span SPAN} "(-" {"" "Import…"} {"" Font} {"" Color}
  28.     {"" Background} {"" Text} {"" Margin}
  29.     {"" Padding} {"" Border} {"" "Border Width"} {"" "Border Style"}
  30.     {"" "Border Color"} {"" Size} {"" Float} 
  31.     {"" Clear} {"" Display} {"" "List Style"}}
  32.  
  33. set htmlHeadersSub {{"<B<O/1" "Header1/H1 no attr" H1}
  34.     {"<B<O/2" "Header2/H2 no attr" H2}
  35.     {"<B<O/3" "Header3/H3 no attr" H3}
  36.     {"<B<O/4" "Header4/H4 no attr" H4}
  37.     {"<B<O/5" "Header5/H5 no attr" H5}
  38.     {"<B<O/6" "Header6/H6 no attr" H6}}
  39.  
  40. set htmlBlocksSub {{"" "Insert Line Breaks/Remove Line Breaks"}
  41.     {"" "Insert Paragraphs"} "(-"
  42.     {"<U/b" "Paragraph/P no attr" P}
  43.     {"<U<O/b" "Division" DIV}
  44.     {"<B<O/Q" "Block Quote" BLOCKQUOTE} {"<B<O/S" "Address" ADDRESS}
  45.     {"<B<O/C" "Center" CENTER} {"<B<O/P" "Preformatted" PRE}
  46.     {"<B<O/X" "Multi Column" MULTICOL}
  47.     {"<B<O/Z" "Spacing" SPACER} "(-"
  48.     {"<O/b" "Line Break/BR no attr" BR}
  49.     {"<B<O/H" "Horizontal Rule/HR no attr" HR}
  50.     {"<B<O/B" "No Line Break" NOBR} {"<B<O/W" "Word Break" WBR}}
  51.  
  52. set htmlStylesSub {{"<B<I/F" Font FONT} {"<B<I/N" Basefont BASEFONT}
  53.     {"" Marquee MARQUEE} "(-" {"<B<I/B" Bold B}
  54.     {"<B<I/I" Italic I} {"<B<I/-" "Strike out" STRIKE} {"<B<I<O/-" Underlined U}
  55.     {"<B<I/." Superscript SUP} {"<B<I/," Subscript SUB} {"<B<I<O/." Bigger BIG}
  56.     {"<B<I<O/," Smaller SMALL} {"<B<I/T" Typewriter TT} {"<B<I/Z" Blinking BLINK}
  57.     "(-" {"<B<I/E" Emphasis EM} {"<B<I/S" Strong STRONG} {"<B<I/D" Definition DFN}
  58.     {"<B<I/C" Code CODE} {"<B<I/V" Variable VAR}    {"<B<I/X" Citation CITE} 
  59.     {"<B<I/K" Keyboard KBD} {"<B<I/P" Sample SAMP}}
  60.  
  61. set htmlLinksSub {{"<B<O/A" "Link or Anchor" A} {"<B<O/I" Image IMG}
  62.     {"" Object OBJECT} {"" Sound BGSOUND}}
  63.  
  64. set htmlPlug-insSub {{"<B<O/E" General EMBED} {"" LiveAudio EMBED}
  65.     {"" LiveVideo EMBED} {"" "QuickTime Movie" EMBED}
  66.     {"" "QuickTime VR" EMBED} {"" RealAudio EMBED} "(-" {"<B<O/N" "No Embed" NOEMBED}}
  67.  
  68. set htmlListsSub {{"" "Make List…"} "(-" {"<B<O/U" "Bulleted/UL no attr" UL}
  69.     {"<B<I/U" "New Bulleted Item"}
  70.     {"<B<O/O" "Numbered/OL no attr" OL}
  71.     {"<B<I/O" "New Numbered Item"} {"<B<O/D" "Directory" DIR}
  72.     {"<B<O/M" "Menu" MENU} {"<B<I/L" "New List Item" LI} "(-"
  73.     {"<B<U<O/D" "Discursive" DL} {"<B<I<O/L" "New Discursive Entry"}}
  74.  
  75. set htmlFormsSub {{"<B<U/F" Form FORM} "(-" {"<B<U/T" Text INPUT}
  76.     {"<B<U/B" Checkbox  INPUT} {"<B<U/N" Button INPUT}
  77.     {"<B<U/R" Radio INPUT} {"<B<U/S" Submit INPUT}
  78.     {"<B<U/C" Reset INPUT} {"<B<U/P" Password INPUT}
  79.     {"<B<U/H" Hidden INPUT} {"<B<U/I" Image INPUT}
  80.     {"<B<U/U" "File Upload" INPUT}
  81.     "(-" {"<B<U<I/S" Select SELECT} {"<B<U/O" Option OPTION}
  82.     {"<B<U<I/T" Textarea TEXTAREA} {"" "Key Generator" KEYGEN}}
  83.  
  84. set htmlTablesSub {{"" "Table Template…"} {"" "Tabs to Rows…/Rows to Tabs"} {"" "Import Table…"} "(-"
  85.     {"<U<O/T" Table TABLE} {"<U<O/R" "Row/TR no attr" TR}
  86.     {"<U<O/H" "Header/TH no attr" TH} {"<U<O/D" "Cell/TD no attr" TD}
  87.     {"<U<O/C" Caption CAPTION} "(-"
  88.     {"" Head THEAD} {"" Body TBODY} {"" Foot TFOOT}
  89.     "(-" {"" "Column Group" COLGROUP} {"" "Column" COL}}
  90.  
  91. set htmlFramesSub {{"<B<U<I/F" "New Doc. with Frames…"} "(-" {"<B<U<I/O" Frameset FRAMESET}
  92.     {"<B<U<I/R" Frame FRAME} {"" "Inline Frame" IFRAME}
  93.     {"<B<U<I/N" "No Frames" NOFRAMES}}
  94.  
  95. set htmlImageSub {{"" "Convert NCSA Map…"} {"" "Convert CERN Map…"} "(-" {"<B<U/M" Map MAP} 
  96.     {"<B<U/A" Area AREA}}
  97.  
  98. set htmlJavaSub {{"<U<I<O/J" Applet APPLET} {"<U<I<O/P" Parameter PARAM}
  99.     "(-" {"<U<I<O/S" Script SCRIPT} {"<U<I<O/N" "No Script" NOSCRIPT}}
  100.  
  101. set htmlLayersSub {{"" Layer LAYER} {"" "Inline Layer" ILAYER} {"" "No Layer" NOLAYER}}
  102.  
  103. set htmlOtherSub {{"<B<U<I/C" Comment} {"<B<U<I/B" Base BASE}
  104.     {"<B<U<I/I" Isindex ISINDEX}
  105.     {"<B<U<I/L" Link LINK} {"<B<U<I/M" Meta META} {"" "Comment Line"}}
  106.  
  107. set htmlSubMenus {HTML Browsers Packages Preferences
  108. {Style Sheets} Headers {Blocks and Dividers} Styles Links 
  109. Plug-ins Lists Forms Tables Frames {Image Maps} {Java and JavaScript} Layers Other}
  110.  
  111. # Index of which menu is the first with HTML elements.
  112. set htmlStartElements 4
  113.  
  114. # Returns a list defining a submenu.
  115. proc htmlBuildOneMenu {me} {
  116.     global htmlMenuKey
  117.     set me0 [lindex $me 0]
  118.     global html${me0}Sub
  119.     # CSS menu share with Style menu
  120.     if {$me0 == "CSS"} {set me0 Style}
  121.     set tmp ""
  122.     foreach it [set html[lindex $me 0]Sub] {
  123.         if {$it == "(-"} {lappend tmp $it; continue}
  124.         if {[info exists htmlMenuKey(${me0}/[lindex $it 1])]} {
  125.             set key $htmlMenuKey(${me0}/[lindex $it 1])
  126.         } else {
  127.             set key [lindex $it 0]
  128.         }
  129.         set it2 [split [lindex $it 1] /]
  130.         if {[llength $it2] == 1} {
  131.             lappend tmp "$key[lindex $it2 0]"
  132.         } elseif {$key != ""} {
  133.             lappend tmp "<S$key[lindex $it2 0]" "<S<I$key[lindex $it2 1]"
  134.         } else {
  135.             lappend tmp "<S$key[lindex $it2 1]" "<S$key[lindex $it2 0]"
  136.         }
  137.     }
  138.     return $tmp
  139. }
  140.  
  141. # Rebuilds a submenu.
  142. proc htmlRebuildOneMenu {me {deleteCache 0}} {
  143.     set meny [htmlBuildOneMenu [lindex $me 0]]
  144.     menu -M HTML -p htmlMenuItem -m -n $me $meny
  145.     if {[info commands "html[lindex $me 0]MenuExtra"] != ""} {
  146.         eval html[lindex $me 0]MenuExtra
  147.     }
  148.     if {$deleteCache} {
  149.         htmlDeleteCache "HTML menu cache"
  150.         htmlDeleteCache "HTML Utilities menu cache"
  151.     }
  152.     htmlDisMark
  153.     htmlUtilDisMark
  154. }
  155.  
  156. proc htmlReadMenuKeys {} {
  157.     global PREFS
  158.     if {[file exists "$PREFS:HTML:Menu key bindings"]} {
  159.         catch {uplevel #0 [list source "$PREFS:HTML:Menu key bindings"]}
  160.     }
  161. }
  162.  
  163. proc htmlWriteMenuKeys {} {
  164.     global PREFS htmlMenuKey
  165.     if {![info exists htmlMenuKey]} {return}
  166.     message "Saving custom key bindings…"
  167.     foreach m [array names htmlMenuKey] {
  168.         lappend txt "set htmlMenuKey(\[list $m\]) [list $htmlMenuKey($m)]"
  169.     }
  170.     if {![file exists $PREFS]} {mkdir $PREFS}
  171.     if {![file exists $PREFS:HTML]} {mkdir $PREFS:HTML}
  172.     set fid [open "$PREFS:HTML:Menu key bindings" w]
  173.     puts $fid [join $txt \n]
  174.     close $fid
  175.     unset htmlMenuKey
  176. }
  177.  
  178. #===============================================================================
  179. # Custom Key Bindings
  180. #===============================================================================
  181.  
  182. proc htmlKeyBindings {} {
  183.     global htmlSubMenus htmlUtilSubMenus htmlMenuKey
  184.     set ret ""
  185.     set rebuildHTML 0
  186.     set rebuildUtils 0
  187.     set rebuildCSS 0
  188.     set somethingModified 0
  189.     htmlReadMenuKeys
  190.     while {$ret != "Done" && ![catch {listpick -p "Choose a submenu to change key bindings in" [lsort [concat $htmlSubMenus $htmlUtilSubMenus]]} meny] && $meny != ""} {
  191.         set ret [htmlSetKeysInMenu $meny]
  192.     }
  193.     if {$somethingModified} {htmlWriteMenuKeys}
  194.     if {$rebuildHTML} {htmlRebuildMenu "Rebuilding HTML menu…"; message "Done."}
  195.     if {$rebuildUtils} {htmlRebuildUtilsMenu "Rebuilding HTML Utilities menu…"; message "Done."}
  196.     if {$rebuildCSS} {cssRebuildMenu}
  197.     catch {unset htmlMenuKey}
  198. }
  199.  
  200. # Redefine key bindings in one submenu.
  201. proc htmlSetKeysInMenu {meny} {
  202.     global htmlMenuKey htmlModeIsLoaded cssModeIsLoaded
  203.     set funcKeys {Enter Return Tab "Num Lock" F1 F2 F3 F4 F5 F6 F7 F8 F9 F10 F11 F12 F13 F14 F15
  204.     Help Delete "Fwd Del" Home End "Page Up" "Page Down"}
  205.     
  206.     set meny0 [lindex $meny 0]
  207.     global html${meny0}Sub
  208.     # CSS menu share with Style menu
  209.     if {$meny0 == "CSS"} {set meny0 Style}
  210.     set items [set html[lindex $meny 0]Sub]
  211.     regsub -all {\"\(-\"} $items "" items
  212.     foreach it $items {
  213.         if {[info exists htmlMenuKey(${meny0}/[lindex $it 1])]} {
  214.             set tmpKeys([lindex $it 1]) $htmlMenuKey(${meny0}/[lindex $it 1])
  215.         } else {
  216.             set tmpKeys([lindex $it 1]) [lindex $it 0]
  217.         }
  218.     }    
  219.     set modified ""
  220.     while {1} {
  221.         # Build dialog.
  222.         set box ""
  223.         set h 30
  224.         foreach it $items {
  225.             if {$it == "(-"} {continue}
  226.             set key $tmpKeys([lindex $it 1])
  227.             set key1 ""
  228.             if {[regexp {<B} $key]} {append key1 "ctrl-"}
  229.             if {[regexp {<U} $key]} {append key1 "shift-"}
  230.             if {[regexp {<I} $key]} {append key1 "opt-"}
  231.             if {[regexp {<O} $key]} {append key1 "cmd-"}
  232.             if {[regexp {/(.)} $key a b]} {
  233.                 if {[string compare $b a] == -1 || [string compare $b z] == 1} {
  234.                     append key1 $b
  235.                 } else {
  236.                     append key1 [lindex $funcKeys [expr [htmlAscii $b] - 97]]
  237.                 }
  238.             }
  239.             set it2 [split [lindex $it 1] /]
  240.             if {[llength $it2] == 1} {
  241.                 lappend box -t [lindex $it2 0] 65 $h 205 [expr $h + 15] -t $key1 210 $h 370 [expr $h + 15]
  242.                 lappend box -b Set… 10 $h 55 [expr $h + 15]
  243.                 incr h 17
  244.             } elseif {$key1 != ""} {
  245.                 lappend box -t [lindex $it2 0] 65 $h 205 [expr $h + 15] -t $key1 210 $h 370 [expr $h + 15]
  246.                 lappend box -b Set… 10 [expr $h + 8] 55 [expr $h + 23]
  247.                 incr h 17
  248.                 regsub {((ctrl-)?(shift-)?)(.*)} $key1 {\1opt-\4} key1
  249.                 lappend box -t [lindex $it2 1] 65 $h 205 [expr $h + 15] -t $key1 210 $h 370 [expr $h + 15]
  250.                 incr h 17
  251.             } else {
  252.                 lappend box -t [lindex $it2 0] 65 $h 205 [expr $h + 15]
  253.                 lappend box -b Set… 10 [expr $h + 8] 55 [expr $h + 23]
  254.                 incr h 17
  255.                 lappend box -t [lindex $it2 1] 65 $h 205 [expr $h + 15]
  256.                 incr h 17
  257.             }
  258.         }
  259.         if {$meny == "CSS"} {
  260.             set buttons "-b OK 20 [expr $h + 10] 85 [expr $h + 30] -b Cancel 105 [expr $h + 10] 170 [expr $h + 30]"
  261.             set cancel 1
  262.         } else {
  263.             set buttons "-b Continue 20 [expr $h + 10] 85 [expr $h + 30] -b Done 105 [expr $h + 10] 170 [expr $h + 30] \
  264.             -b Cancel 190 [expr $h + 10] 255 [expr $h + 30]"
  265.             set cancel 2
  266.         }
  267.         set values [eval [concat dialog -w 380 -h [expr $h + 40] \
  268.         $buttons -t [list $meny] 50 10 250 25 $box]]
  269.         if {[lindex $values $cancel]} {
  270.             # Cancel
  271.             return "Done"
  272.         } elseif {[lindex $values 0] || [lindex $values 1]} {
  273.             # Continue or Done
  274.             # Save new key bindings
  275.             foreach it $modified {
  276.                 set htmlMenuKey(${meny0}/$it) $tmpKeys($it)
  277.             }
  278.             htmlDeleteCache "CSS keybindings cache"
  279.             if {[llength $modified]} {
  280.                 uplevel 1 {set somethingModified 1}
  281.                 switch $meny {
  282.                     HTML {uplevel 1 {set rebuildHTML 1}}
  283.                     Utilities {uplevel 1 {set rebuildUtils 1}}
  284.                     "Style Sheets" {
  285.                         # Rebuild both Style sheet menu and CSS menu
  286.                         htmlDeleteCache "CSS menu cache"
  287.                         htmlRebuildOneMenu "Style Sheets" 1
  288.                         if {[info exists cssModeIsLoaded]} {uplevel 1 {set rebuildCSS 1}}
  289.                     }
  290.                     CSS {
  291.                         # Rebuild both Style sheet menu and CSS menu
  292.                         if {[info exists htmlModeIsLoaded]} {
  293.                             htmlRebuildOneMenu "Style Sheets" 1
  294.                         } else {
  295.                             htmlDeleteCache "HTML menu cache"
  296.                         }
  297.                         uplevel 1 {set rebuildCSS 1}
  298.                     }
  299.                     default {
  300.                         htmlRebuildOneMenu $meny 1
  301.                         # Redefine key bindinds in CSS mode.
  302.                         if {[info exists cssModeIsLoaded]} {
  303.                             foreach k [array names oldKeys] {
  304.                                 lappend re [list $k $oldKeys($k) $tmpKeys($k)]
  305.                                 cssReBindKey $meny0 $re
  306.                             }
  307.                         }
  308.                     }
  309.                 }
  310.             }
  311.             if {[lindex $values 1]} {return "Done"}
  312.             return
  313.         } else {
  314.             # Get a new key.
  315.             set it [lindex [lindex $items [expr [lsearch $values 1] - 1 - $cancel]] 1]
  316.             if {![catch {htmlGetAKey $it $tmpKeys($it)} newKey] && $newKey != $tmpKeys($it)} {
  317.                 set oldKeys($it) $tmpKeys($it)
  318.                 set tmpKeys($it) $newKey
  319.                 lappend modified $it
  320.             }
  321.         }
  322.     }
  323. }
  324.  
  325. # Ask for a key binding for a menu item.
  326. proc htmlGetAKey {elem keystr} {
  327.     set funcKeys {Enter Return Tab "Num Lock" F1 F2 F3 F4 F5 F6 F7 F8 F9 F10 F11 F12 F13 F14 F15
  328.     Help Delete "Fwd Del" Home End "Page Up" "Page Down"}
  329.     set option [expr ![regexp {/} $elem]]
  330.     if {[string length $keystr]} {
  331.         set values "0 0"
  332.         set key [string range $keystr [expr [string length $keystr] - 1] end]
  333.         if {[string compare $key a] == -1 || [string compare $key z] == 1} {
  334.             lappend values "Normal key"
  335.             set mkey $key
  336.         } else {
  337.             lappend values [lindex $funcKeys [expr [htmlAscii $key] - 97]]
  338.             set mkey {}
  339.         }
  340.         lappend values [regexp {<U} $keystr]
  341.         lappend values [regexp {<B} $keystr]
  342.         if {$option} {lappend values [regexp {<I} $keystr]}
  343.         lappend values [regexp {<O} $keystr]
  344.         lappend values $mkey
  345.     } else {
  346.         set values {0 0 "Normal key"}
  347.     }
  348.     while {1} {
  349.         set box "-t {Key binding for '$elem'} 10 10 315 25 \
  350.         -t Key 10 40 40 55 \
  351.         -m [list [concat [list [lindex $values 2]] [list "<No binding>" "Normal key"] $funcKeys]] 80 40 250 55 \
  352.         -c Shift [list [lindex $values 3]] 10 70 60 85 \
  353.         -c Control [list [lindex $values 4]] 80 70 150 85"
  354.         if {$option} {lappend box -c Option [lindex $values 5] 160 70 220 85}
  355.         lappend box -c Command [lindex $values [expr 5 + $option]] 230 70 315 85
  356.         lappend box -n "Normal key" -e [lindex $values [expr 6 + $option]] 50 40 70 55
  357.         set values [eval [concat dialog -w 320 -h 130 \
  358.         -b OK 20 100 85 120 -b Cancel 105 100 170 120 $box]]
  359.         if {[lindex $values 1]} {error "Cancel"}
  360.         set elemKey [string toupper [string trim [lindex $values [expr 6 + $option]]]]
  361.         set special [lindex $values 2]
  362.         set keyStr ""
  363.         if {[lindex $values 3]} {append keyStr "<U"}
  364.         if {[lindex $values 4]} {append keyStr "<B"}
  365.         if {$option && [lindex $values 5]} {append keyStr "<I"}
  366.         if {[lindex $values [expr 5 + $option]]} {append keyStr "<O"}
  367.         if {$special == "<No binding>"} {break}
  368.         if {[string length $elemKey] > 1 && $special == "Normal key"} {
  369.             alertnote "You should only give one character for key binding."
  370.         } elseif {$special == "Normal key" && [htmlAscii $elemKey] > 126} {
  371.             alertnote "Sorry, can't define a key binding with $elemKey."
  372.         } elseif {$elemKey != "" && $special == "Normal key" && ($keyStr == "" || $keyStr == "<U")} {
  373.             alertnote "You must choose at least one of the modifiers control, option and command."
  374.         } elseif {![regexp {F[0-9]} $special] && $special != "Tab" && $special != "Normal key" && $keyStr == ""} {
  375.             alertnote "You must choose at least one modifier."
  376.         } else {
  377.             break
  378.         }
  379.     }
  380.     if {$special == "<No binding>"} {set elemKey ""}
  381.     if {$special != "Normal key" && $special != "<No binding>"} {set elemKey [htmlAscii [expr [lsearch -exact $funcKeys $special] + 97] 1]}
  382.     if {![string length $elemKey]} {
  383.         set keyStr ""
  384.     } else {
  385.         append keyStr "/$elemKey"
  386.     }    
  387.     return $keyStr
  388. }
  389.  
  390.